COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Editor: Aux routines for parsing motion-type statements }
C00005 00003	(* moveParse *)
C00011 00004	(* stopParse *)
C00014 00005	(* returnParse *)
C00016 00006	(* wristParse *)
C00020 ENDMK
C⊗;
{$NOMAIN	Editor: Aux routines for parsing motion-type statements }

%include eparse.hdr;

{ Externally defined routines from elsewhere: }

	(* XX from eextra or someplace *)
function getcsys(defcsys: boolean): boolean;			external;

	(* From ALLOC *)
function newNode: nodep;					external;
procedure relNode(n: nodep);					external;

	(* From EROOT:  Inter-overlay calls *)
function e3fExprParse: nodep;					external;

	(* From EAUX1B *)
function getDtype(n: nodep): datatypes;				external;
function checkArg(n: nodep; d: datatypes): nodep;		external;

	(* From EAUX1C *)
procedure errprnt;						external;
function getdim(n: nodep; var d: nodep): nodep;			external;
function evalOrder(what,last: nodep; pcons: boolean): nodep;	external;
procedure relExpr(n: nodep);					external;

	(* From ETOKEN *)
procedure getToken;						external;
procedure dimCheck(n,d: nodep);				external;
procedure getDelim(char: ascii);				external;

	(* From EMOVEO *)
procedure moveOrder(st: statementp);				external;

	(* From PP *)
procedure ppLine; 						external;
procedure ppOutNow; 						external;
procedure ppChar(ch: ascii); 					external;
procedure pp5(ch: c5str; length: integer); 			external;
procedure pp10(ch: cstring; length: integer); 			external;
procedure pp10L(ch: cstring; length: integer);			external;
procedure pp20(ch: c20str; length: integer); 			external;
procedure pp20L(ch: c20str; length: integer); 			external;
procedure ppInt(i: integer); 					external;
procedure ppReal(r: real); 					external;
procedure ppStrng(length: integer; s: strngp); 			external;
procedure ppDtype(d: datatypes);				external;
procedure ppDelChar; 						external;


procedure ePar3fGet; external;
procedure ePar3fGet;  begin end;

(* moveParse *)

procedure moveParse(st: statementp; bp: boolean); external;
procedure moveParse;
 var b,movep,jointp,operatep,centerp,openp,floatp: boolean; dest: nodep;
 begin
 with st↑ do
  begin
  movep := stype = movetype;
  jointp := stype = jtmovetype;
  operatep := stype = operatetype;
  centerp := stype = centertype;
  floatp := stype = floattype;
  openp := (stype = opentype) or (stype = closetype);
  cf := e3fExprParse;			(* what are we moving *)
  if movep and (cf <> nil) then
    if (cf↑.ntype = exprnode) and (cf↑.op = jointop) then
      begin movep := false; jointp := true; stype := jtmovetype end;
  if movep or centerp or floatp then 
    cf := checkArg(cf,frametype)
   else cf := checkArg(cf,svaltype);
  with cf↑ do					(* make sure it's a variable *)
   begin
   if jointp and ((ntype <> exprnode) or (op <> jointop)) then
     begin movep := true; jointp := false; stype := movetype end;
   b := (ntype <> leafnode) or (ltype <> varitype);
   if b then b := (ntype <> exprnode) or ((op <> arefop) and (op <> jointop));
   if not b then			(* ok so far, check some more *)
    if centerp then
     begin					(* check for arms *)
     if ntype <> leafnode then b := true
      else b := (vari↑.level <> 0) or not (vari↑.offset in [0,4]);
	(* offsets: 0=garm, 4=rarm *)
     end
    else if operatep then
     begin					(* check for driver *)
     if ntype <> leafnode then b := true
      else b := (vari↑.level <> 0) or (vari↑.offset <> 8);
	(* offset: 8=driver *)
     end
    else if openp then
     begin					(* check for scalar devices *)
     if ntype <> leafnode then b := true
      else b := (vari↑.level <> 0) or not (vari↑.offset in [2,6,12]);
	(* offsets: 2=ghand, 6=rhand, 12=vise *)
     end;
   end;
  if b then
    begin
    pp20L(' Need a device varia',20); pp10('ble here  ',8); errprnt;
    bad := true;			(* mark statement as bad *)
    end
   else
    bad := false;				(* statement is ok *)
  getToken;					(* see if there's a TO clause *)
  if movep or jointp or openp then
    begin					(* deal with possible dest *)
    dest := clauses;
    if dest <> nil then
      begin
      with dest↑ do
       if (ntype = ffnode) and pdef then dest := next;
      if dest↑.ntype <> destnode then dest := nil
       else relExpr(dest↑.loc);
      end;
    with curToken do
     begin
     if (ttype = reswdtype) and (rtype = filtype) and (filler = totype) then
       begin					(* get destination *)
       if dest = nil then
	 begin				(* make a new destination node *)
	 dest := newNode;
	 with dest↑ do
	  begin
	  ntype := destnode;
	  code := nil;
	  next := clauses;			(* splice us into clause list *)
	  clauses := dest;
	  end;
	 end;
       with dest↑ do
	begin
	if movep then loc := checkArg(e3fExprParse,transtype)
	 else loc := checkArg(e3fExprParse,svaltype);
	if not jointp then dimCheck(loc,distancedim↑.dim)
	 else dimCheck(loc,angledim↑.dim);
	getToken;			(* see if anything else on line *)
	end
       end
      else
       if dest <> nil then		(* delete old destination clause *)
	 begin 
	 if clauses = dest then clauses := dest↑.next
	  else clauses↑.next := dest↑.next;	(* system created ffnode *)
	 relNode(dest);
	 end;
     end;
    end;
  backup := true;
  with curToken do
   if not (bp or endOfLine or ((ttype = delimtype) and (ch = ';'))) then
     begin
     pp20L('Sorry, can''t deal wi',20); pp20('th last part of line',20); errprnt;
     (* *** maybe instead should call addstmnt here??? *** *)
     end;
  end;

 moveOrder(st);
 end;

(* stopParse *)

procedure stopParse(st: statementp); external;
procedure stopParse;
 var d: datatypes; b: boolean; i: integer;

 procedure complain;
  begin					(* no good *)
  pp20L(' Need a device varia',20); pp10('ble here  ',8); errprnt;
  end;

 begin					(* stop & setbase statements *)
 with st↑ do
  begin
  b := true;
  clauses := nil;
  cf := e3fExprParse;			(* what are we stopping? *)
  if cf = nil then	(* use default = cf of current motion (if any) *)
    begin
    if stype = setbasetype then complain
     else
      begin
      i := cursor;
      while (i > 1) and b do
       with cursorStack[i] do
	if stmntp and (movetype <= st↑.stype) and (st↑.stype <= floattype) then
	  b := false else i := i - 1;
      if b then
	begin
	pp20L(' Need to specify wha',20); pp10('t to Stop ',9); errprnt;
	end
      end
    end
   else
    begin				(* make sure it's a variable *)
    d := getDtype(cf);
    with cf↑ do
     if ((ntype = leafnode) and (ltype = varitype)) or
	((ntype = exprnode) and (op = arefop)) then	(* a variable? *)
       if d = frametype then b := false		(* assume any frame var is ok *)
	else if stype = setbasetype then b := true (* scalar devs no good for setbase *)
	else if (d = svaltype) and (ntype = leafnode) then
	 if (vari↑.level = 0) and	(* check for scalar devices *)
	    (vari↑.offset in [2,6,8,12]) then b := false;
	(* offsets: 2=ghand, 6=rhand, 8=driver, 12=vise *)
    if b then complain;
    end
  end;
 end;

(* returnParse *)

procedure returnParse(st: statementp); external;
procedure returnParse;
 var n,np: nodep;
 begin
 relExpr(st↑.retval);			(* flush the old expression *)
 st↑.retval := e3fExprParse;		(* parse the modified expression *)
 n := st↑.rproc;			(* find def of procedure we're in *)
 if n = nil then
   begin		(* yow - shouldn't allow a return here *)
   pp20L(' Can''t have a return',20); pp5('here ',4); errPrnt;
   end
  else if n↑.pname↑.vtype = nulltype then
   begin			(* procedure doesn't return a result *)
   pp20L(' Procedure doesn''t r',20); pp20('eturn result        ',12); errPrnt;
   end
  else if st↑.retval <> nil then
   begin
   st↑.retval := checkArg(st↑.retval,n↑.pname↑.vtype);
   np := nil;
   dimCheck(st↑.retval,getdim(n,np));
   relNode(np);
   end
  else
   begin pp20L(' Need a value to ret',20); pp10('urn with  ',8); errPrnt end;
 with st↑ do
  if retval <> nil then exprs := evalOrder(retval,nil,true)
   else exprs := nil;
 end;

(* wristParse *)

procedure wristParse(st: statementp); external;
procedure wristParse;
 var b: boolean; n: nodep;

 procedure complain;
   begin
   st↑.bad := true;			(* mark statement as bad *)
   pp20L(' Need variable here ',19); errprnt;
   end;

 begin
 with st↑ do
  begin
  bad := false;				(* assume statement is ok *)
  getDelim('(');
  fvec := checkArg(e3fExprParse,vectype);
  dimCheck(fvec,forcedim↑.dim);
  with fvec↑ do			(* make sure it's a variable *)
   if not (((ntype = exprnode) and (op = arefop)) or
	   ((ntype = leafnode) and (ltype = varitype))) then complain;
  getDelim(',');
  tvec := checkArg(e3fExprParse,vectype);
  dimCheck(tvec,torquedim↑.dim);
  with tvec↑ do			(* make sure it's a variable *)
   if not (((ntype = exprnode) and (op = arefop)) or
	   ((ntype = leafnode) and (ltype = varitype))) then complain;
  getDelim(')');
  b := false;
  arm := nil;
  ff := nil;
  csys := false;		(* assume hand coords *)
  repeat
   getToken;			(* look for ABOUT, IN or OF spec *)
   with curToken do
    if (ttype = reswdtype) and (rtype = filtype) and
       ((filler = abouttype) or (filler = intype) or (filler = oftype)) then
      case filler of
abouttype: begin
	   ff := checkArg(e3fExprParse,transtype);
	   dimCheck(ff,distancedim↑.dim);
	   end;
intype:	   csys := getcsys(false);	(* get coord sys, hand = default *)
oftype:	   begin
	   arm := checkArg(e3fExprParse,frametype);
	   with arm↑ do
	    if not (((ntype = leafnode) and (ltype = varitype)) or
		    ((ntype = exprnode) and (op = arefop))) then
	      begin				(* not a variable - no good *)
	      pp20L(' Need a device varia',20); pp10('ble here  ',8); errprnt;
	      end;
	   end;
      end
     else begin backup := true; b := true end;	(* all done *)
  until b;
  n := nil;
  if arm <> nil then
   with arm↑ do
    if (ntype = exprnode) and (op = arefop) then
      n := evalorder(arg2,n,true);	(* deal with subscripts *)
  if ff <> nil then
    n := evalorder(ff,n,true);		(* push wrist frame *)
  with fvec↑ do
   if (ntype = exprnode) and (op = arefop) then
     n := evalorder(arg2,n,true);	(* deal with subscripts *)
  with tvec↑ do
   if (ntype = exprnode) and (op = arefop) then
     n := evalorder(arg2,n,true);	(* deal with subscripts *)
  exprs := n;
  end
 end;